Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 009 / pecolor.bas (.txt) < prev next >

Wrap

GW-BASIC | 1984-04-24 | 9.3 KB | 352 lines

10 COLOR 7,0 20 SCREEN 0,0,0 30 WIDTH 80 40 CLS 50 CLOSE 60 KEY OFF 70 DEFINT A-Z 80 REC=5165<UNK! {0009}> ' FIRST 7 BYTES ARE THE COLOR CONTROL BYTES 90 ' 100 ' WRITTEN BY : JAMES P MORGAN 110 ' 1749 AMERICANA BLVD 23-G 120 ' ORLANDO FLA. 32809 130 ' PH: WORK= 305-826-7279 140 ' HOME= 305-859-5658 150 ' 160 ' THE ORIGINAL THOUGHT AS TO WHAT BYTES OF THE PERSONAL EDITOR 170 ' NEEDED TO BE CHANGED TO MODIFY THE CHARACTER COLORS 180 ' GOES TO JAMES JOHNSEN SO I WONT TAKE CREDIT FOR HIS WORK. 190 ' HOWEVER MOST OF YOU ARE NOT THAT VERSED ON "DEBUG" OR THE 200 ' FORMAT OF THE COLOR BYTE ATTRIBUTES. 210 ' THIS BASIC PROGRAM WILL INSURE THAT YOU USE THE CORRECT BIT SETTINGS 220 ' AS WELL AS PROVIDE EASE OF USE. IF YOU HAVE ANY PROBLEMS, EITHER 230 ' WRITE OR LEAVE A MESSAGE ON RICH'S OR WES MERCHANTS BBS. 240 ' 250 ' LOCATION VALUE FUNCTION 260 ' -------- ----- -------- 270 ' 1 X'07' COLOR OF TEXT YOU SEE ON THE SCREEN. 280 ' THIS CAN BE EITHER TEXT THAT YOU LOAD INTO 290 ' WHITE/BLACK THE EDITOR OR SOMETHING YOU TYPE IN. 300 ' 310 ' 2 X'70' COLOR THE TEXT BECOMES IF YOU MARK IT FOR 320 ' BLACK/WHITE EITHER MOVING OR COPYING OR WHAT-HAVE-YOU. 330 ' 340 ' 3 X'17' COLOR USED WHEN YOU PRESS THE ESCAPE KEY TO 350 ' LEAVE ENTERING TEXT IN THE EDITOR TO THE 360 ' WHITE/BLUE COMMAND LINE. THE CHARACTER WHERE THE CURSOR 370 ' WAS IS LEFT "MARKED" ON THE EDIT SCREEN. 380 ' THIS IS THE COLOR VALUE FOR THAT "MARKER". 390 ' SPECIFICALLY, THIS IS THE COLOR VALUE USED 400 ' WHEN LEAVING THE EDIT SCREEN IF THE CURSOR 410 ' IS ON AN UNMARKED (FOR BLOCK COPY..MOVE). 420 ' 430 ' 4 X'71' COLOR USED WHEN YOU PRESS THE ESCAPE KEY TO 440 ' LEAVE ENTERING TEXT IN THE EDITOR COMMAND LINE. 450 ' BLUE/WHITE THE CHARACTER WHERE THE CURSOR WAS IS LEFT 460 ' "MARKED" ON THE EDIT SCREEN. UNLIKE ABOVE 470 ' (LOCATION 3) THIS COLOR VALUE IS USED IF THE 480 ' CURSOR WAS RESTING ON A MARKED AREA OF TEXT 490 ' (FOR BLOCK COPY OR MOVE OR ECT..). 500 ' 510 ' 5 X'71' COLOR OF TEXT ON THE COMMAND LINE AS YOU TYPE 520 ' IT ON THE COMMAND LINE. THE '7' IN THE '71' IS 530 ' BLUE/WHITE THE COLOR USED FOR THE COMMAND LINE. ON EVERY 540 ' MONITOR I'VE SEEN, THIS IS LOW INTENSITY WHITE 550 ' 560 ' 6 X'07' COLOR OF TEXT BENEATH THE COMMAND LINE. THIS 570 ' COLOR IS USED FOR THE TEXT 'REPLACE' AND 580 ' WHITE/BLACK 'INSERT' AND THE NUMBER THAT TELL YOU WHAT ROW 590 ' AND COLUMN YOU ARE CURRENTLY TYPING. 600 ' 610 ' 7 X'04' COLOR USED FOR THE ERROR MESSAGES. 620 ' RED/BLACK 630 ' 640 ' COLOR ATTRIBUTE FORMAT 650 ' ---------------------- 660 ' 670 ' 7 6 5 4 3 2 1 0 ------- BIT NUMBERS 680 ' ------------------------------- 690 ' B | R | G | B | I | R | G | B ------- BIT ATTRIBUTE 700 ' ------------------------------- 710 ' | | 720 ' FG | BACKGROUND| FORE GROUND 730 ' 740 ' FG = 1 THEN FOREGROUND BLINK 750 ' I = 1 THEN HIGH INTENSITY FOREGOROUND 760 ' 770 ' R G B 780 ' 0 0 0 = BLACK 790 ' 0 0 1 = BLUE 800 ' 0 1 0 = GREEN 810 ' 0 1 1 = CYAN 820 ' 1 0 0 = RED 830 ' 1 0 1 = MAGENTA 840 ' 1 1 0 = YELLOW 850 ' 1 1 1 = WHITE 860 ' 870 ' 880 BLACK=0 890 BLUE=1 900 GREEN=2 910 CYAN=3 920 RED=4 930 MAGENTA=5 940 YELLOW=6 950 WHITE=7 960 HIGH.INTENSITY=8 970 BLINKING=128 980 FORE.GROUND=1 990 BACK.GROUND=16 1000 GOSUB 2350 1010 GOSUB 3140 1020 ' 1030 OPEN "PE.EXE" AS #1 LEN=8 1040 ' 1050 GET 1,REC 1060 FIELD 1,8 AS A$ 1070 BYTE$=A$ 1080 GOSUB 2080 1090 GOSUB 2660 1100 GOSUB 3050 1110 ROW=0 1120 COL=0 1130 LOCATE ROWS(ROW),COLS(COL),1 1140 GOSUB 1520 'CLEAR KEYBOARD BUFFERS 1150 KEYIN$=INKEY$ 1160 IF KEYIN$="" GOTO 1150 1170 IF LEN(KEYIN$)=1 GOTO 1250 1180 KEYIN$=RIGHT$(KEYIN$,1) 1190 IF KEYIN$=CHR$(75) THEN GOSUB 1930: GOTO 1150 'CURSOR LEFT 1200 IF KEYIN$=CHR$(77) THEN GOSUB 1880: GOTO 1150 'CURSOR RIGHT 1210 IF KEYIN$=CHR$(72) THEN GOSUB 1980: GOTO 1150 'CURSOR UP 1220 IF KEYIN$=CHR$(80) THEN GOSUB 2020: GOTO 1150 'CURSOR DOWN 1230 BEEP 1240 GOTO 1140 1250 IF KEYIN$=CR$ GOTO 1310 1260 IF KEYIN$="+" THEN DIRECTION=1:GOSUB 1570:GOTO 1140 1270 IF KEYIN$="-" THEN DIRECTION=-1:GOSUB 1570:GOTO 1140 1280 IF KEYIN$=ESC$ GOTO 1490 1290 BEEP 1300 GOTO 1140 1310 GOSUB 2950 1320 LOCATE 25,1,0 1330 PRINT STRING$(79," "); 1340 LOCATE 25,1,1 1350 COLOR 15,0 1360 PRINT "ARE YOU SURE YOU WANT TO USE THESE COLOR ATTRIBUTES (Y/N) ? "; 1370 COLOR 7,0:GOSUB 1520 1380 KEYIN$=INKEY$ 1390 IF KEYIN$="" GOTO 1380 1400 IF LEN(KEYIN$)<>1 THEN BEEP:GOTO 1370 1410 IF KEYIN$=ESC$ GOTO 1490 1420 IF KEYIN$="N" OR KEYIN$="n" GOTO 1010 1430 IF KEYIN$="Y" OR KEYIN$="y" GOTO 1460 1440 BEEP 1450 GOTO 1370 1460 LSET A$=BYTE$ 1470 ON ERROR GOTO 3390 1480 PUT 1,REC 1490 CLOSE 1500 CLS 1510 END 1520 DEF SEG=0 1530 POKE 1050,PEEK(1052) 1540 DEF SEG 1550 POKE 106,0 1560 RETURN 1570 IF COL=0 THEN GOSUB 1810:RETURN 1580 IF COL=1 THEN GOSUB 1640:RETURN 1590 IF COL=2 THEN GOSUB 1690:RETURN 1600 IF COL=3 THEN GOSUB 1740:RETURN 1610 PRINT"PROGRAM TRAP REACHED" 1620 STOP 1630 END 1640 INTENSITY(ROW)=INTENSITY(ROW) XOR 1 1650 LOCATE ROWS(ROW),COLS(COL),0 1660 PRINT HILOW$(INTENSITY(ROW)); 1670 LOCATE ROWS(ROW),COLS(COL),1 1680 RETURN 1690 BLINK(ROW)=BLINK(ROW) XOR 1 1700 LOCATE ROWS(ROW),COLS(COL),0 1710 PRINT YESNO$(BLINK(ROW)); 1720 LOCATE ROWS(ROW),COLS(COL),1 1730 RETURN 1740 B.GROUND(ROW)=(B.GROUND(ROW) + DIRECTION) 1750 IF B.GROUND(ROW)<0 THEN B.GROUND(ROW)=7 1760 IF ABS(B.GROUND(ROW))>7 THEN B.GROUND(ROW)=0 1770 LOCATE ROWS(ROW),COLS(COL),0 1780 PRINT COLORS$(ABS(B.GROUND(ROW))); 1790 LOCATE ROWS(ROW),COLS(COL),1 1800 RETURN 1810 F.GROUND(ROW)=(F.GROUND(ROW) + DIRECTION) 1820 IF F.GROUND(ROW)<0 THEN F.GROUND(ROW)=7 1830 LOCATE ROWS(ROW),COLS(COL),0 1840 IF ABS(F.GROUND(ROW))>7 THEN F.GROUND(ROW)=0 1850 PRINT COLORS$(ABS(F.GROUND(ROW))); 1860 LOCATE ROWS(ROW),COLS(COL),1 1870 RETURN 1880 COL=COL+1 1890 IF COL>3 THEN ROW=ROW+1:COL=0 1900 IF ROW>6 THEN ROW=0 1910 GOSUB 2060 1920 RETURN 1930 COL=COL-1 1940 IF COL<0 THEN COL=3:ROW=ROW-1 1950 IF ROW<0 THEN ROW=6 1960 GOSUB 2060 1970 RETURN 1980 ROW=ROW-1 1990 IF ROW<0 THEN ROW=6 2000 GOSUB 2060 2010 RETURN 2020 ROW=ROW+1 2030 IF ROW>6 THEN ROW=0 2040 GOSUB 2060 2050 RETURN 2060 LOCATE ROWS(ROW),COLS(COL),1 2070 RETURN 2080 CLS 2090 PRINT TAB(32);"PERSONAL EDITOR" 2100 PRINT 2110 PRINT TAB(29);"COLOR SELECTION MENU" 2120 PRINT 2130 PRINT TAB(4);"FORE INTENSITY BLINK BACK" 2140 PRINT TAB(3);"GROUND (FOREG) (FOREG) GROUND";TAB(43);"FUNCTION OF AREA FOR COLOR DEFINITION" 2150 PRINT 2160 PRINT TAB(42);"COLOR OF TEXT YOU SEE ON THE SCREEN" 2170 PRINT 2180 PRINT TAB(42);"COLOR OF TEXT WHEN IT IS MARKED" 2190 PRINT 2200 PRINT TAB(42);"COLOR WHEN YOU LEAVE THE TEXT LINE" 2210 PRINT 2220 PRINT TAB(42);"COLOR WHEN YOU LEAVE THE COMMAND LINE" 2230 PRINT 2240 PRINT TAB(42);"COLOR OF TEXT ON THE COMMAND LINE" 2250 PRINT 2260 PRINT TAB(42);"COLOR OF TEXT BENEATH THE COMMAND LINE" 2270 PRINT 2280 PRINT TAB(42);"COLOR USED FOR ERROR MESSAGES" 2290 LOCATE 22,1 2300 PRINT "USE CURSOR KEYS TO MOVE AROUND THE SCREEN ; 'ESC' TO EXIT PROGRAM" 2310 PRINT "USE '+' OR '-' TO CHANGE ANY COLOR ATTRIBUTES" 2320 LOCATE 25,1 2330 PRINT"PRESS 'ENTER' ONLY WHEN YOU WANT TO MAKE THE CHANGES PERMANANT"; 2340 RETURN 2350 DIM COLS(4),ROWS(7),COLORS$(8) 2360 DIM B.GROUND(7) 2370 DIM F.GROUND(7) 2380 DIM HILOW$(2) 2390 DIM YESNO$(2) 2400 HILOW$(0)="NORMAL" 2410 HILOW$(1)="HIGH " 2420 YESNO$(0)="NO " 2430 YESNO$(1)="YES" 2440 CR$=CHR$(13) 2450 ESC$=CHR$(27) 2460 FOR I=0 TO 3 2470 READ COLS(I) 2480 NEXT 2490 FOR I=0 TO 6 2500 READ ROWS(I) 2510 NEXT 2520 FOR I=0 TO 7 2530 READ COLORS$(I) 2540 NEXT 2550 RETURN 2560 DATA 2,13,24,31 2570 DATA 8,10,12,14,16,18,20 2580 DATA "BLACK " 2590 DATA "BLUE " 2600 DATA "GREEN " 2610 DATA "CYAN " 2620 DATA "RED " 2630 DATA "MAGENTA" 2640 DATA "YELLOW " 2650 DATA "WHITE " 2660 FOR I=1 TO 7 2670 COLOR.ATTR=ASC(MID$(BYTE$,I,1)) 2680 GOSUB 2730 2690 GOSUB 2780 2700 NEXT 2710 GOSUB 2840 2720 RETURN 2730 INTENSITY=(COLOR.ATTR AND HIGH.INTENSITY) / 8 2740 BLINK=(COLOR.ATTR AND BLINKING) / 128 2750 F.GROUND=COLOR.ATTR AND 7 2760 B.GROUND=(COLOR.ATTR AND 112) / 16 2770 RETURN 2780 I1=I-1 2790 B.GROUND(I1)=B.GROUND 2800 F.GROUND(I1)=F.GROUND 2810 INTENSITY(I1)=INTENSITY 2820 BLINK(I1)=BLINK 2830 RETURN 2840 FOR ROW=0 TO 6 2850 FOR COL=0 TO 3 2860 GOSUB 2900 2870 NEXT 2880 NEXT 2890 RETURN 2900 IF COL=0 THEN GOSUB 1830 2910 IF COL=1 THEN GOSUB 1650 2920 IF COL=2 THEN GOSUB 1700 2930 IF COL=3 THEN GOSUB 1760 2940 RETURN 2950 FOR I=1 TO 7 2960 COLOR.ATTR=0 2970 ROW=I-1 2980 COLOR.ATTR=B.GROUND(ROW) * BACK.GROUND 2990 COLOR.ATTR=COLOR.ATTR + (F.GROUND(ROW) * FORE.GROUND) 3000 COLOR.ATTR=COLOR.ATTR + (INTENSITY(ROW) * HIGH.INTENSITY) 3010 COLOR.ATTR=COLOR.ATTR + (BLINK(ROW) * BLINKING) 3020 MID$(BYTE$,I,1)=CHR$(COLOR.ATTR) 3030 NEXT 3040 RETURN 3050 RETURN 3060 X=CSRLIN 3070 Y=POS(0) 3080 LOCATE 25,1,0 3090 FOR J=1 TO 8 3100 PRINT ASC(MID$(BYTE$,J,1));" "; 3110 NEXT 3120 LOCATE X,Y,1 3130 RETURN 3140 CLS 3150 CLOSE 3160 ON ERROR GOTO 3270 3170 PRINT 3180 PRINT "PUT DISKETTE WITH PERSONAL EDITOR IN DRIVE 'A:'" 3190 PRINT "PRESS ANY KEY TO CONTINUE, OR 'ESC' TO EXIT PROGRAM" 3200 GOSUB 1520 3210 KEYIN$=INKEY$ 3220 IF KEYIN$="" GOTO 3210 3230 IF KEYIN$=ESC$ GOTO 1490 3240 FILES "PE.EXE" 3250 ON ERROR GOTO 0 3260 RETURN 3270 ENO=ERR 3280 RESUME 3290 3290 ON ERROR GOTO 0 3300 PRINT 3310 IF ENO<>53 THEN PRINT "BASIC ERROR ";ENO:GOTO 3330 3320 PRINT "PE.EXE NOT FOUND ON DISKETTE IN DRIVE 'A:'" 3330 PRINT "CORRECT PROBLEM AND PRESS ANY KEY TO CONTINUE" 3340 GOSUB 1520 3350 KEYIN$=INKEY$ 3360 IF KEYIN$="" GOTO 3350 3370 IF KEYIN$=ESC$ GOTO 1490 3380 GOTO 3160 3390 CLS 3400 PRINT 3410 ENO=ERR 3420 RESUME 3430 3430 ON ERROR GOTO 0 3440 IF ENO<>70 THEN PRINT "BASIC ERROR ";ENO:GOTO 3460 3450 PRINT "DISKETTE IS WRITE PROTECTED" 3460 PRINT "CORRECT THE PROBLEM AND PRESS ANY KEY TO CONTINUE" 3470 GOSUB 1520 3480 KEYIN$=INKEY$ 3490 IF KEYIN$="" GOTO 3480 3500 IF KEYIN$=ESC$ GOTO 1490 3510 GOTO 1470